home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / v3 / sim.lha / sim / gc.c < prev    next >
C/C++ Source or Header  |  1990-04-12  |  16KB  |  538 lines
  1. #include "simdef.h"
  2. #include "aux.h"
  3.  
  4. /* debugging macro definitions */
  5. /*
  6. #define DEBUG_MARK
  7. #define DEBUG_COMPACT
  8. */
  9. /* macros used by garbage collection */
  10.  
  11. #define MBIT           0x80000000    /* mark bit */
  12. #define RBIT           0x40000000    /* relocation chain bit */
  13.  
  14. #define GET_NEXT(ptr)  ((LONG_PTR)(*(ptr) & 0x3ffffffc))
  15.      /* return pointer from object pointed to by ptr (remove tag & mark) */
  16.  
  17. #define HEAP_PTR(ptr)  (!ISNUM(*(ptr)) && \
  18.             GET_NEXT(ptr) >= heap_bottom && GET_NEXT(ptr) < hreg)
  19.      /* is the object pointed to by ptr a pointer to the heap? */
  20.  
  21. #define ONHEAP(ptr)    ((ptr) >= heap_bottom && (ptr) < hreg)
  22.      /* is ptr a pointer to the heap? */
  23.  
  24. #define MARKED(ptr)    (*(ptr) &  MBIT)
  25.      /* is the object pointed to by ptr marked? */
  26.  
  27. #define MARK(ptr)      (*(ptr) |= MBIT)
  28.      /* mark the object pointed to by ptr */
  29.  
  30. #define UNMARK(ptr)    (*(ptr) &= ~MBIT)
  31.      /* unmark the object pointed to by ptr */
  32.  
  33. #define RMARKED(ptr)   (!ISNUM(*(ptr)) && (*(ptr) & RBIT))
  34.      /* is the object pointed to by ptr marked as in a relocation chain? */
  35.  
  36.  
  37. /*
  38.  * Assumptions:
  39.  *   1. breg points one past last choicepoint
  40.  *   2. ereg points to first word in last environment
  41.  *   3. local_bottom points two past actual bottom of local stack
  42.  *   4. there are only environments and choicepoints on the local stack
  43.  *   5. hreg points one past the last entry on the heap
  44.  *   6. heap_bottom points to bottom of heap
  45.  *   7. there are only value cells (FREE,CS,LIST,NUM) and buffers on the heap
  46.  *   8. trreg points to last entry in trail
  47.  *   9. trail_bottom points one past bottom of trail
  48.  *  10. the trail can point to the heap
  49.  *  11. buffers on the heap always have psc record right after psc_ptr word
  50.  *  12. buffers on the heap have an extra word at the end (end_buf) which
  51.  *      contains the psc_ptr ORed with CS_TAG
  52.  *  13. pointers don't use bit 30, so it can be used as r-bit during compaction
  53.  *      (r-bit not used for numbers - before checking r-bit, test for ISNUM)
  54.  */
  55.  
  56.  
  57. /*
  58.  * During garbage collection, chains of environments and choicepoints are
  59.  * followed to find active objects on the heap.  The pointers gc_ereg and
  60.  * gc_breg, local to garbage collection, point to the environment or
  61.  * choicepoint, respectively, currently being processed.  The values
  62.  * generated by offsetting from gc_ereg and gc_breg are as follows:
  63.  *
  64.  *     gc_ereg     = saved ereg
  65.  *     gc_ereg - 1 = saved cpreg
  66.  *     gc_ereg - 2 = start saved variables
  67.  *
  68.  *     gc_breg + 2 = saved breg
  69.  *     gc_breg + 3 = saved hreg
  70.  *     gc_breg + 5 = saved cpreg
  71.  *     gc_breg + 6 = saved ereg
  72.  *     gc_breg + 7 = start saved registers
  73.  */
  74.  
  75.  
  76. /* global variables for garbage collection */
  77.  
  78. LONG gc_calls = 0;      /* number of times GC has been called */
  79. LONG total_marked;      /* number of heap objects marked */
  80. int  num_regs;          /* number of active registers */
  81.  
  82.  
  83. /* find all accessible objects on the heap and squeeze out all the rest */
  84.  
  85. garbage_collection(from)
  86. CHAR_PTR from;
  87. {
  88.    gc_calls++;
  89.    printf("Performing garbage collection number %d; called from %s\n",
  90.       gc_calls, from);  fflush(stdout);
  91.  
  92.    total_marked = 0;
  93.  
  94.    /* get the number of active registers */
  95.  
  96.    num_regs = *(BYTE_PTR)((LONG)cpreg - 6);
  97.  
  98. #ifdef DEBUG_MARK
  99.    printf("the number of active registers is %d\n", num_regs);
  100. #endif
  101.  
  102.    push_registers();
  103.  
  104.    marking_phase();
  105.  
  106. #ifdef DEBUG_MARK
  107.    dump_mem();
  108. #endif
  109.  
  110.    compaction_phase();
  111.  
  112.    pop_registers();
  113.  
  114. #ifdef DEBUG_COMPACT
  115.    dump_mem();
  116. #endif
  117.  
  118. }
  119.  
  120.  
  121. /* push the active registers onto the trail for inclusion during gc */
  122.  
  123. push_registers()
  124. {
  125.    int i;
  126.  
  127.    for (i = 1; i <= num_regs; i++)
  128.       *(--trreg) = reg[i];
  129.    if (trreg < tstack)             /* just check at end; if bad,   */
  130.       quit("Trail overflow\n");    /*   we're going to quit anyway */
  131. }
  132.  
  133.  
  134. /* mark all objects on the heap that are accessible from active registers,
  135.    the trail, environments, and choicepoints */
  136.  
  137. marking_phase()
  138. {
  139.    mark_trail();                               /* active registers & trail */
  140.    mark_environments(ereg, ENV_SIZE(cpreg));   /* active environments */
  141.    mark_choicepoints(breg);                    /* choicepoints, and environs  */
  142.                                                /* reachable from choicepoints */
  143. }
  144.  
  145.  
  146. /* move marked heap objects upwards over unmarked objects, and reset all 
  147.    pointers to point to new locations */
  148.  
  149. compaction_phase()
  150. {
  151.    sweep_trail();
  152.    sweep_environments(ereg, ENV_SIZE(cpreg));
  153.    sweep_choicepoints(breg);
  154.    compact_heap();
  155. }
  156.  
  157.  
  158. /* pop the corrected register values from the trail and update the registers */
  159.  
  160. pop_registers()
  161. {
  162.    int i;
  163.  
  164.    for (i = num_regs; i >= 1; i--)
  165.       reg[i] = *trreg++;
  166. }
  167.  
  168.  
  169. /* mark all heap objects accessible from the trail (which includes the
  170.    active general purpose registers) */
  171.  
  172. mark_trail()
  173. {
  174.    LONG_PTR trail_cell;
  175.  
  176.    for (trail_cell = trreg; trail_cell < trail_bottom; trail_cell++)
  177.       if (HEAP_PTR(trail_cell)) {
  178.          mark_variable(trail_cell);
  179.          total_marked--;                       /* don't count trail cells */
  180.       }
  181. }
  182.  
  183.  
  184. /* mark all heap objects accessible from a chain of environments */
  185.  
  186. mark_environments(gc_ereg, size)
  187. LONG_PTR gc_ereg;
  188. BYTE     size;
  189. {
  190.    LONG_PTR saved_var;
  191.  
  192.    while (size > 0) {                          /* no more environments */
  193.  
  194.       /* for each saved variable */
  195.  
  196.       for (saved_var = gc_ereg-size+1; saved_var < gc_ereg-1; saved_var++) {
  197.          if (MARKED(saved_var))                /* we have already been here */
  198.             return;
  199.          else if (HEAP_PTR(saved_var)) {
  200.             mark_variable(saved_var);
  201.             total_marked--;                    /* don't count stack cells */
  202.          }
  203.       }
  204.       size = ENV_SIZE((LONG_PTR)*(gc_ereg-1)); /* size = ENV_SIZE(cpreg) */
  205.       gc_ereg = (LONG_PTR)*(gc_ereg);          /* link to prev environment */
  206.    }
  207. }
  208.  
  209.  
  210. /* mark all heap objects accessible from each choicepoint & its chain
  211.    of environments */
  212.  
  213. mark_choicepoints(gc_breg)
  214. LONG_PTR gc_breg;
  215. {
  216.    LONG_PTR prev_top, saved_reg;
  217.    BYTE     size;
  218.  
  219.    while (gc_breg != local_bottom-2) {         /* original value of breg */
  220.       size = ENV_SIZE((LONG_PTR)*(gc_breg+5));
  221.       mark_environments((LONG_PTR)*(gc_breg+6), size);
  222.  
  223.       /* find previous top of stack */
  224.  
  225.       if (*(gc_breg+2) < *(gc_breg+6))         /* breg < ereg ? */
  226.          prev_top = (LONG_PTR)*(gc_breg+2);    /* prev_top = breg */
  227.       else                                     /* prev_top = ereg - env_size */
  228.          prev_top = (LONG_PTR)*(gc_breg+6) - size;
  229.  
  230.       /* for each saved register */
  231.  
  232.       for (saved_reg = gc_breg+7; saved_reg <= prev_top; saved_reg++)
  233.          if (HEAP_PTR(saved_reg)) {
  234.             mark_variable(saved_reg);
  235.             total_marked--;                    /* don't count stack cells */
  236.          }
  237.       gc_breg = (LONG_PTR)*(gc_breg+2);        /* link to prev choicepoint */
  238.    }
  239. }
  240.  
  241.  
  242. /* mark a heap object and all heap objects accessible from it */
  243.  
  244. mark_variable(current)
  245. LONG_PTR current;
  246. {
  247.    LONG_PTR    next;
  248.    PSC_REC_PTR psc_ptr;
  249.    BYTE        arity, i;
  250.    LONG        bufsiz;
  251.  
  252.    if (MARKED(current))
  253.       return;
  254.    MARK(current);
  255.    total_marked++;
  256.    next = GET_NEXT(current);
  257.  
  258.    switch (TAG(*current)) {
  259.       case FREE:
  260.          if (ONHEAP(next))
  261.         mark_variable(next);
  262.          return;
  263.  
  264.       case CS:
  265.          if (ISNIL(*current))                  /* last element in a list */
  266.             return;
  267.      if (MARKED(next))
  268.         return;
  269.          psc_ptr = (PSC_REC_PTR)*next;         /* *next == psc_ptr */
  270.  
  271.          if (IS_BUFF(psc_ptr)) {               /* buffer */
  272.         if (HEAP_PTR(next)) {              /* buffer is on heap */
  273.            bufsiz = BUFF_SIZE(psc_ptr);
  274.            MARK(next);                     /* mark the psc_ptr word */
  275.            MARK(next + bufsiz - 1);        /* mark the end_buff ptr */
  276.            /* add the number of words in the buffer into total_marked, */
  277.            /*   but don't actually mark them                           */
  278.                total_marked += bufsiz;
  279.         }
  280.             return;
  281.          }
  282.  
  283.      if ((arity=GET_ARITY(psc_ptr)) == 0)  /* constant */
  284.         return;
  285.                                            /* structure */
  286.          for (i = 1; i <= arity; i++)
  287.             if (ONHEAP(next + i))
  288.            mark_variable(next + i);
  289.      MARK(next);                           /* mark the psc_ptr word */
  290.      total_marked++;
  291.          return;
  292.  
  293.       case LIST:
  294.          if (ONHEAP(next))
  295.         mark_variable(next);
  296.          if (ONHEAP(next + 1))
  297.         mark_variable(next + 1);
  298.          return;
  299.  
  300.       case NUM:
  301.          return;
  302.    }
  303. }
  304.  
  305.  
  306. /* insert a cell which points to a heap object into relocation chain of that
  307.    object */
  308.  
  309. into_relocation_chain(current, next)
  310. LONG_PTR current, next;
  311. {
  312.    LONG current_tag;
  313.  
  314.    current_tag = TAG(*current);
  315.    *current = (*current & MBIT) | (*next & ~MBIT);
  316.    *next = (*next & MBIT) | RBIT | (LONG)current | current_tag;
  317. } 
  318.  
  319.  
  320. /* insert trail cells which point to heap objects into relocation chains */
  321.  
  322. sweep_trail()
  323. {
  324.    LONG_PTR trail_cell;
  325.  
  326.    for (trail_cell = trreg; trail_cell < trail_bottom; trail_cell++)
  327.       if (HEAP_PTR(trail_cell)) {
  328.      UNMARK(trail_cell);
  329.          into_relocation_chain(trail_cell, GET_NEXT(trail_cell));
  330.       }
  331. }
  332.  
  333.  
  334. /* insert cells of a chain of environments which point to heap objects
  335.    into relocation chains */
  336.  
  337. sweep_environments(gc_ereg, size)
  338. LONG_PTR gc_ereg;
  339. BYTE     size;
  340. {
  341.    LONG_PTR saved_var;
  342.  
  343.    while (size > 0) {
  344.  
  345.       /* for each saved variable */
  346.  
  347.       for (saved_var = gc_ereg-size+1; saved_var < gc_ereg-1; saved_var++) {
  348.          if (HEAP_PTR(saved_var)) {
  349.             if (!MARKED(saved_var))
  350.            return;                         /* we have already been here */
  351.             else {
  352.                UNMARK(saved_var);
  353.                into_relocation_chain(saved_var, GET_NEXT(saved_var));
  354.             }
  355.          }
  356.       }
  357.       size = ENV_SIZE((LONG_PTR)*(gc_ereg-1)); /* size = ENV_SIZE(cpreg) */
  358.       gc_ereg = (LONG_PTR)*(gc_ereg);          /* link to prev environment */
  359.    }
  360. }
  361.  
  362.  
  363. /* insert cells of each choicepoint & its chain of environments which point to
  364.    heap objects into relocation chains */
  365.  
  366. sweep_choicepoints(gc_breg)
  367. LONG_PTR gc_breg;
  368. {
  369.    LONG_PTR prev_top, saved_reg, hptr;
  370.    BYTE     size;
  371.  
  372.    while (gc_breg != local_bottom-2) {        /* original value of breg */
  373.       size = ENV_SIZE((LONG_PTR)*(gc_breg+5));
  374.       sweep_environments((LONG_PTR)*(gc_breg+6), size);
  375.  
  376.       /* find previous top of stack */
  377.  
  378.       if (*(gc_breg+2) < *(gc_breg+6))        /* breg < ereg ? */
  379.      prev_top = (LONG_PTR)*(gc_breg+2);   /* prev_top = breg */
  380.       else                                    /* prev_top = ereg - env_size */
  381.      prev_top = (LONG_PTR)*(gc_breg+6) - size;
  382.       
  383.       /* for each saved register */
  384.  
  385.       for (saved_reg = gc_breg+7; saved_reg <= prev_top; saved_reg++) {
  386.          if (HEAP_PTR(saved_reg)) {
  387.             UNMARK(saved_reg);
  388.             into_relocation_chain(saved_reg, GET_NEXT(saved_reg));
  389.          }
  390.       }
  391.  
  392.       /* if the word pointed to by saved hreg is not marked, find  */
  393.       /*   the first word above it that is marked, and point to it */
  394.  
  395.       hptr = (LONG_PTR)*(gc_breg+3);          /* word ptd to by saved hreg */
  396.       while (!MARKED(hptr) && hptr < hreg)
  397.          hptr++;
  398.       *(gc_breg+3) = (LONG)hptr;              /* point to marked word */
  399.       if (hptr == hreg) {                     /* no more marked words; */
  400.      *hptr = 0x80000002;                  /*   create one          */
  401.      hreg++;
  402.      total_marked++;
  403.       }
  404.       into_relocation_chain(gc_breg+3, hptr); /* insert into relocation chain */
  405.  
  406.       gc_breg = (LONG_PTR)*(gc_breg+2);       /* link to prev choicepoint */
  407.    }
  408. }
  409.  
  410.  
  411.  
  412.  
  413. /* move marked objects on the heap upwards over unmarked objects, and reset
  414.    all pointers to point to new locations */
  415.  
  416. compact_heap()
  417. {
  418.    LONG_PTR    dest, current, next;
  419.    PSC_REC_PTR psc_ptr;
  420.    LONG        i, bufsiz;
  421.  
  422.    /* upward phase - scan heap from high to low, setting marked upward ptrs */
  423.    /* to point to what will be the new locations of the objects pointed to  */
  424.  
  425.    dest = heap_bottom + total_marked - 1;
  426.    for (current = hreg - 1; current >= heap_bottom; current--) {
  427.       if (MARKED(current)) {
  428.          update_relocation_chain(current, dest);
  429.          if (HEAP_PTR(current)) {
  430.         next = GET_NEXT(current);
  431.         if (TAG(*current) == CS &&           /* buffer; update its ptrs */
  432.             IS_BUFF((PSC_REC_PTR)next)) {
  433.            psc_ptr = (PSC_REC_PTR)next;
  434.            bufsiz = BUFF_SIZE(psc_ptr);
  435.            dest -= bufsiz - 1;               /* correct dest for size */
  436.            *current = (LONG)(dest + 1) | CS_TAG;
  437.            *(next + 1) = (GET_LENGTH(psc_ptr) == LONGBUFF) ?  /* name ptr */
  438.                          (LONG)(dest + 4) : (LONG)(dest + 3);
  439.            current -= bufsiz - 1;            /* correct current for size */
  440.         }
  441.             else if (next < current)             /* push into reloc. chain */
  442.                into_relocation_chain(current, next);
  443.             else if (current == next)            /* cell pointing to itself */
  444.                *current = (*current & MBIT) | (LONG)dest;    /* no tag */
  445.          }
  446.      dest--;
  447.       } else if (HEAP_PTR(current) && TAG(*current) == CS &&
  448.                  IS_BUFF((PSC_REC_PTR)GET_NEXT(current))) {
  449.      /* unmarked buffer; update current to jump over buffer */
  450.          current -= BUFF_SIZE((PSC_REC_PTR)GET_NEXT(current)) - 1;
  451.       }
  452.    }
  453.  
  454.    /* downward phase - scan heap from low to high, moving marked objects to  */
  455.    /* their new locations & setting downward pointers to pt to new locations */
  456.  
  457.    dest = heap_bottom;
  458.    for (current = heap_bottom; current < hreg; current++) {
  459.       if (MARKED(current)) {
  460.          update_relocation_chain(current, dest);
  461.      next = GET_NEXT(current);
  462.      if (HEAP_PTR(current) &&                /* buffer; move whole thing */
  463.          *current | ~MBIT == (LONG)(current + 1) &&
  464.          IS_BUFF((PSC_REC_PTR)next)) {
  465.         psc_ptr = (PSC_REC_PTR)next;
  466.         *current = (LONG)(dest + 1);
  467.         bufsiz = BUFF_SIZE(psc_ptr);
  468.         for (i = 1; i < bufsiz; i++)
  469.            *dest++ = *current++;
  470.         *dest = *current;
  471.      }
  472.          else if (HEAP_PTR(current) &&           /* move current cell & push */
  473.           next > current) {              /*   into relocation chain  */
  474.         *dest = *current;
  475.             into_relocation_chain(dest, next);
  476.      }
  477.          else                                    /* just move current cell */
  478.         *dest = *current;
  479.          UNMARK(dest);
  480.      dest++;
  481.       } else if (HEAP_PTR(current) && *current == (LONG)(current + 1) &&
  482.              IS_BUFF((PSC_REC_PTR)GET_NEXT(current))) {
  483.      /* unmarked buffer; update current to jump over buffer */
  484.      current += BUFF_SIZE((PSC_REC_PTR)GET_NEXT(current)) - 1;
  485.       }
  486.    }
  487.    hreg = dest;                                  /* reset hreg */
  488. }
  489.  
  490.  
  491. /* update a relocation chain to point all its cells to new location of object */
  492.  
  493. update_relocation_chain(current, dest)
  494. LONG_PTR current, dest;
  495. {
  496.    LONG_PTR next;
  497.    LONG     current_tag;
  498.  
  499.    while (RMARKED(current)) {
  500.       current_tag = TAG(*current);
  501.       next = GET_NEXT(current);
  502.       *current = (*current & MBIT) | (*next & ~MBIT);
  503.       *next = (*next & MBIT) | (LONG)dest | current_tag;
  504.    }
  505. }
  506.  
  507.  
  508. /* dump memory for debugging purposes */
  509.  
  510. dump_mem()
  511. {
  512.    int      i;
  513.    LONG_PTR ptr;
  514.  
  515.    printf("\n");
  516.    printf("curr_fence   = %08x\n", curr_fence);
  517.    printf("cpreg        = %08x\n", cpreg);
  518.    printf("hreg         = %08x\n", hreg);
  519.    printf("ereg         = %08x\n", ereg);
  520.    printf("breg         = %08x\n", breg);
  521.    printf("trreg        = %08x\n", trreg);
  522.    printf("\n");
  523.    printf("total_marked = %ld\n",  total_marked);
  524.    printf("\n");
  525.    for (i = 1; i <= num_regs; i++) 
  526.       printf("reg[%d] = %08x\n", i, reg[i]);
  527.    printf("heap:\n");
  528.    for (ptr = heap_bottom; ptr <= hreg; ptr++)
  529.       printf("  %08x -> %08x\n", ptr, *ptr);
  530.    printf("local stack:\n");
  531.    ptr = (breg < ereg) ? breg : ereg - ENV_SIZE(cpreg);
  532.    for ( ; ptr <= local_bottom; ptr++) 
  533.       printf("  %08x -> %08x\n", ptr, *ptr);
  534.    printf("trail:\n");
  535.    for (ptr = trreg; ptr <= trail_bottom; ptr++)
  536.       printf("  %08x -> %08x\n", ptr, *ptr);
  537. }
  538.